perm filename ATOMS.FAI[LSP,BGB] blob
sn#017667 filedate 1972-12-27 generic text, type T, neo UTF8
00100 SUBTTL ATOMS
00200 ;LISP ATOMS AND OBLIST.
00300
00400 ATOMS:
00500
00600 ;Make an Atom.
00700
00800 DEFINE MKAT '(name,type,C,D){
00900 D XWD -1,.+1
01000 XWD type,.+1
01100 XWD C'name,0
01200 ASCII/name/
01300 }
01400 DEFINE MKAT1 '(iname,type,oname,C){
01600 XWD -1,.+1
01700 XWD type,.+1
01800 XWD C'iname,0
01900 ASCII/oname/
02000 }
02100
02200 ;Make Labels.
02300
02400 DEFINE ML(name){
02500 name: XWD -1,0
02600 ASCII/name/
02700 }
02800
02900
00100 ;All the Value Cells.
00200 VNIL: NIL
00300 %NOPOINT: NIL
00400 VTRUTH: TRUTH
00500 FOO VOBLIST: ATOMS-bckets
00600 VBASE: 8+INUM0
00700 VIBASE: 8+INUM0
00800 VBPORG: INUM0
00900 VBPEND: INUM0
01000
01100 ;The atom prototype of NIL.
01200 ;0: -1,.+1 ;Atom Head in Accumulator 0.
01300 CNIL2: XWD VALUE,.+1
01400 XWD VNIL,0
01500 ASCII/NIL/
01600
01700 ;The atom prototype of T.
01800 TRUTH: XWD -1,.+1
01900 XWD VALUE,.+1
02000 XWD VTRUTH,0
02100 ASCII/T/
00100 MKAT RPLACA,SUBR
00200 MKAT RPLACD,SUBR
00300 MKAT MINUS,SUBR
00400 MKAT TERPRI,SUBR
00500 MKAT READ,SUBR
00600
00700 MKAT1 CAR.,SUBR,CAR
00800 MKAT1 CDR.,SUBR,CDR
00900 MKAT1 DIP.,SUBR,DIP
01000 MKAT1 DAP.,SUBR,DAP
01100
01200 MKAT CAAR,SUBR
01300 MKAT CADR,SUBR
01400 MKAT CDAR,SUBR
01500 MKAT CDDR,SUBR
01600
01700 MKAT CAAAR,SUBR
01800 MKAT CAADR,SUBR
01900 MKAT CADAR,SUBR
02000 MKAT CADDR,SUBR
02100 MKAT CDAAR,SUBR
02200 MKAT CDADR,SUBR
02300 MKAT CDDAR,SUBR
02400 MKAT CDDDR,SUBR
02500
02600 MKAT CAAAAR,SUBR
02700 MKAT CAAADR,SUBR
02800 MKAT CAADAR,SUBR
02900 MKAT CAADDR,SUBR
03000 MKAT CADAAR,SUBR
03100 MKAT CADADR,SUBR
03200 MKAT CADDAR,SUBR
03300 MKAT CADDDR,SUBR
03400 MKAT CDAAAR,SUBR
03500 MKAT CDAADR,SUBR
03600 MKAT CDADAR,SUBR
03700 MKAT CDADDR,SUBR
03800 MKAT CDDAAR,SUBR
03900 MKAT CDDADR,SUBR
04000 MKAT CDDDAR,SUBR
04100 MKAT CDDDDR,SUBR
04200
04300 MKAT MAKNUM,SUBR
04400 MKAT CONS,SUBR
04500 MKAT1 FIX1A,SUBR,ADDR
00100 MKAT ATOM,SUBR
00200 MKAT EQ,SUBR
00300 MKAT PRIN1,SUBR
00400 MKAT PRINT,SUBR
00500 MKAT RETURN,SUBR
00600
00700 MKAT EXPLODE,SUBR
00800 MKAT SASSOC,SUBR
00900 MKAT ASSOC,SUBR
01000 MKAT GCGAG,SUBR
01100 MKAT CHRCT,SUBR
01200
01300 MKAT LINELENGTH,SUBR
01400 MKAT NUMBERP,SUBR
01500 MKAT EQUAL,SUBR
01600 MKAT GET,SUBR
01700 MKAT INTERN,SUBR
01800
01900 MKAT MEMBER,SUBR
02000 MKAT ED,SUBR
02100 MKAT MAKNAM,SUBR
02200 MKAT READCH,SUBR
02300 MKAT NOT,SUBR
02400
02500 MKAT NULL,SUBR
02600 MKAT GENSYM,SUBR
02700 MKAT ZEROP,SUBR
02800 MKAT DIVIDE,SUBR
02900 MKAT GCD,SUBR
03000
03100 MKAT TIME,SUBR
03200 MKAT FIX,SUBR
03300 MKAT SET,SUBR
03400 MKAT PROG2,SUBR
03500 MKAT LENGTH,SUBR
03600
03700 MKAT READLIST,SUBR
03800 MKAT LAST,SUBR
03900 MKAT ADD1,SUBR
04000 MKAT SUB1,SUBR
04100 MKAT GCTIME,SUBR
04200
04300 MKAT REVERSE,SUBR
04400 MKAT SPEAK,SUBR
04500 MKAT MAPLIST,SUBR
00100 MKAT GC,SUBR
00200 MKAT GETL,SUBR
00300 MKAT BAKGAG,SUBR
00400 MKAT MEMQ,SUBR
00500 MKAT PUTPROP,SUBR
00600
00700 MKAT PRINC,SUBR
00800 MKAT FLATSIZE,SUBR
00900 MKAT ERR,SUBR
01000 MKAT MAPCAR,SUBR
01100 MKAT EXAMINE,SUBR
01200
01300 MKAT DEPOSIT,SUBR
01400 MKAT LSH,SUBR
01500 MKAT NCONS,SUBR
01600 MKAT XCONS,SUBR
01700 MKAT REMPROP,SUBR
01800
01900 MKAT ARG,SUBR
02000 MKAT SETARG,SUBR
02100 MKAT NOUUO,SUBR
02200 MKAT MINUSP,SUBR
02300 MKAT MAP,SUBR
02400
02500 MKAT MAPC,SUBR
02600 MKAT OUTC,SUBR
02700 MKAT INC,SUBR
02800 MKAT DDTIN,SUBR
02900 MKAT INITFN,SUBR
03000
03100 MKAT EXCISE,SUBR
03200 MKAT REMAINDER,SUBR
03300 MKAT ABS,SUBR
03400 MKAT PGLINE,SUBR
03500 MKAT SAIL,SUBR
00100 MKAT EXPLODEC,SUBR,%
00200 MKAT TYO,SUBR,I
00300 MKAT TYI,SUBR,I
00400 CEVAL: MKAT1 EVAL,SUBR,*EVAL
00600
00700 MKAT LIST,FSUBR
00800 MKAT COND,FSUBR
00900 MKAT PROG,FSUBR
01000 MKAT SETQ,FSUBR
01100 MKAT OUTPUT,FSUBR
01200 MKAT GRINDEF,FSUBR
01300
01400 MKAT ERRSET,FSUBR
01500 MKAT REMOB,FSUBR
01600 MKAT OR,FSUBR
01700 MKAT GO,FSUBR
01800 MKAT ARRAY,FSUBR
01900 MKAT STORE,FSUBR
02000
02100 MKAT AND,FSUBR
02200 MKAT DEFPROP,FSUBR
02300 MKAT CSYM,FSUBR
02400 MKAT EXARRAY,FSUBR
02500
02600 MKAT1 QUOTE,FSUBR,FUNCTION
02700 mkat1 INPUT,FSUBR,INPUT
02800 MKAT1 SUBST,SUBR,SUBST
02900 MKAT1 FUNCT,FSUBR,*FUNCTION
03000
03100 MKAT APPEND,LSUBR
03200 MKAT NCONC,LSUBR
03300 MKAT BOOLE,LSUBR
03400 MKAT APPLY,LSUBR
03500
03600 MKAT EVAL,LSUBR,O
03700 MKAT ASCII,SUBR,A
03800 MKAT QUOTE,FSUBR,,CQUOTE:
03900 MKAT INUM0,SYM
00100 MKAT1 LCALL,SYM,*LCALL,INUM0+%
00200 MKAT1 AMAKE,SYM,*AMAKE,INUM0+%
00300 MKAT1 UDT,SYM,*UDT,INUM0+%
00400 MKAT1 %NOPOINT,VALUE,*NOPOINT
00500 UNBOUND: XWD -1,0↔ASCII/UNBOUND/
00600
00700 MKAT1 EXPN1,SUBR,*EXPAND1
00800 MKAT1 EXPAND,SUBR,*EXPAND
00900
01000 MKAT1 PLUS,SUBR,*PLUS,.
01100 MKAT1 DIF,SUBR,*DIF,.
01200 MKAT1 QUO,SUBR,*QUO,.
01300 MKAT1 TIMES,SUBR,*TIMES,.
01400
01500 MKAT1 APPEND,SUBR,*APPEND,.
01600 MKAT1 RSET,SUBR,*RSET,.
01700 MKAT1 GREAT,SUBR,*GREAT,.
01800 MKAT1 LESS,SUBR,*LESS,.
01900
02000 MKAT1 PUTSYM,SUBR,*PUTSYM
02100 MKAT1 GETSYM,SUBR,*GETSYM
02150 mkat XSYM,SUBR
02175 mkat XHALF,SUBR
02200
02300 VSPECBIND←INUM0+SPECBIND
02400 MKAT SPECBIND,SYM,V
02500
02600 VSPECSTR←INUM0+SPECSTR
02700 MKAT SPECSTR,SYM,V
02800
02900 VFIX1A←INUM0+FIX1A
03000 MKAT FIX1A,SYM,V
03100
03200 VNSTR←INUM0+NSTR
03300 MKAT NSTR,SYM,V
00100 XWD -1,.+1
00200 XWD SUBR,.+1
00300 XWD NUMVAL,.+1
00400 XWD SYM,.+1
00500 XWD NUMVAL+INUM0,0
00600 ASCII/NUMVAL/
00700
00800 MKAT OBLIST,VALUE,V
00900 MKAT BASE,VALUE,V
01000 MKAT IBASE,VALUE,V
01100 MKAT BPEND,VALUE,V
01200 MKAT BPORG,VALUE,V
01300
01400 ML PNAME
01500 ML FIXNUM
01600 ML FLONUM
01700 ML VALUE
01800 ML LAMBDA
01900 ML SUBR
02000 ML SAIBR
02100 ML FSUBR
02200 ML EXPR
02300 ML FEXPR
02400 ML SYM
02500 ML $EOF$
02600 ML LABEL
02700 ML FUNARG
02800 ML LSUBR
02900 ML MACRO
03000
03100 LAMBD.: XWD -1,0↔ASCII/λ/
03200 QST: XWD -1,0↔ASCII/?/
03300
03400 ATOME: -1 ;End of the atoms.
00100 ;The FOO list is for fixing up references to HWS.
00200
00300 DEFINE GARP $(A,B)
00400 <XWD FOO$A,FOO$B>
00500
00600 FOO 0
00700 FOO 0
00800 FOOLST:
00900 XLIST
01000 FOR I←0,(FOOCNT-2),2{
01100 GARP (→I,→(I+1))
01200 }
01300 LIST
01400
01500 EFOLST:
01600
01700 END